---
title: "Climate Change Dashboard"
output:
flexdashboard::flex_dashboard:
source_code: embed
---
```{r setup, include=FALSE}
library(dygraphs)
library(xts)
library(lubridate)
library(dplyr)
library(tidyr)
library(leaflet)
library(sp)
library(raster)
library(mapview)
library(leafsync)
#author: Wanda Bodnar
## Data sources:
#https://climate.metoffice.cloud/dashboard.html,
#https://www.metoffice.gov.uk/pub/data/weather/uk/climate/datasets/Tmean/date/UK.txt,
#https://www.metoffice.gov.uk/pub/data/weather/uk/climate/stationdata/heathrowdata.txt,
##https://www.kaggle.com/datasets/noahx1/london-weather-2000-2023,
#https://psmsl.org/data/,
#https://www.sciencedirect.com/science/article/pii/S0079661121000112?via%3Dihub#s0180,
#https://climatedataportal.metoffice.gov.uk/datasets/TheMetOffice::annual-average-temperature-change-projections-12km/about,
#https://climatedataportal.metoffice.gov.uk/datasets/TheMetOffice::annual-precipitation-projections-2050-2079/about,
#https://climatedataportal.metoffice.gov.uk/datasets/TheMetOffice::drought-severity-index-12-month-accumulations-projections/about
```
Global
=====================================
Column {data-width=500}
-------------------------------------
### Carbon-dioxide concentration
```{r}
mauna <- read.csv(url("https://climate.metoffice.cloud/formatted_data/co2_Mauna%20Loa%20CO2.csv"))
mauna$Year <- as.numeric(mauna$Year)
mauna <- mauna %>%
group_by(Year) %>%
dplyr::summarize(Mean_Mauna = mean(Mauna.Loa.CO2..ppm., na.rm = TRUE))
NOAA <- read.csv(url("https://climate.metoffice.cloud/formatted_data/co2_NOAA%20CO2.csv"))
NOAA$Year <- as.numeric(NOAA$Year)
NOAA <- NOAA %>%
group_by(Year) %>%
dplyr::summarize(Mean_NOAA = mean(NOAA.CO2..ppm., na.rm = TRUE))
WDCGG <- read.csv(url("https://climate.metoffice.cloud/formatted_data/co2_WDCGG%20CO2.csv"))
WDCGG$Year <- as.numeric(WDCGG$Year)
WDCGG <- WDCGG %>%
group_by(Year) %>%
dplyr::summarize(Mean_WDCGG = mean(WDCGG.CO2..ppm., na.rm = TRUE))
carbon <- merge(mauna, NOAA, by = "Year", all = T)
carbon <- merge(carbon, WDCGG, by = "Year")
names(carbon)[names(carbon) == "Mean_Mauna"] <- "Mauna Loa"
names(carbon)[names(carbon) == "Mean_NOAA"] <- "NOAA"
names(carbon)[names(carbon) == "Mean_WDCGG"] <- "WDCGG"
dygraph(carbon, main = "") %>%
dyOptions(colors = RColorBrewer::brewer.pal(3, "Set3")) %>%
dyOptions(fillGraph = TRUE, fillAlpha = 0.1) %>%
dyAxis("y", label = "Parts per million (ppm)") %>%
dyRangeSelector()
```
### Global mean temperature difference from 1850-1900
```{r}
HadCRUT5 <- read.csv(url("https://climate.metoffice.cloud/formatted_data/gmt_HadCRUT5.csv"))
HadCRUT5$Year <- as.numeric(HadCRUT5$Year)
NOAA <- read.csv(url("https://climate.metoffice.cloud/formatted_data/gmt_NOAAGlobalTemp.csv"))
NOAA$Year <- as.numeric(NOAA$Year)
berkeley <- read.csv(url("https://climate.metoffice.cloud/formatted_data/gmt_Berkeley%20Earth.csv"))
berkeley$Year <- as.numeric(berkeley$Year)
temp <- merge(HadCRUT5, NOAA, by = "Year", all = T)
temp <- merge(temp, berkeley, by = "Year", all = T)
temp <- subset(temp, select= -c(HadCRUT5.uncertainty, NOAAGlobalTemp.uncertainty, Berkeley.Earth.uncertainty))
names(temp)[names(temp) == "HadCRUT5..degC."] <- "Met Office"
names(temp)[names(temp) == "NOAAGlobalTemp..degC."] <- "NOAA"
names(temp)[names(temp) == "Berkeley.Earth..degC."] <- "Berkeley Earth"
dygraph(temp, main = "") %>%
dyOptions(colors = RColorBrewer::brewer.pal(3, "Dark2")) %>%
dyOptions(fillGraph = TRUE, fillAlpha = 0.1) %>%
dyAxis("y", label = "Temperature (°C)") %>%
dyRangeSelector()
```
Row {data-height=500}
-------------------------------------
### Global ocean heat content difference from 1981-2010
```{r}
EN.4.2.2.c14 <- read.csv(url("https://climate.metoffice.cloud/formatted_data/ohc_EN.4.2.2.c14.csv"))
EN.4.2.2.c14$Year <- as.numeric(EN.4.2.2.c14$Year)
Levitus <- read.csv(url("https://climate.metoffice.cloud/formatted_data/ohc_Levitus.csv"))
Levitus$Year <- as.numeric(Levitus$Year)
EN.4.2.2.c13 <- read.csv(url("https://climate.metoffice.cloud/formatted_data/ohc_EN.4.2.2.c13.csv"))
EN.4.2.2.c13$Year <- as.numeric(EN.4.2.2.c13$Year)
EN.4.2.2.g10 <- read.csv(url("https://climate.metoffice.cloud/formatted_data/ohc_EN.4.2.2.g10.csv"))
EN.4.2.2.g10$Year <- as.numeric(EN.4.2.2.g10$Year)
EN.4.2.2.l09 <- read.csv(url("https://climate.metoffice.cloud/formatted_data/ohc_EN.4.2.2.l09.csv"))
EN.4.2.2.l09$Year <- as.numeric(EN.4.2.2.l09$Year)
IAP <- read.csv(url("https://climate.metoffice.cloud/formatted_data/ohc_IAP.csv"))
IAP$Year <- as.numeric(IAP$Year)
JMA <- read.csv(url("https://climate.metoffice.cloud/formatted_data/ohc_JMA.csv"))
JMA$Year <- as.numeric(JMA$Year)
oceanheat <- merge(EN.4.2.2.c14, Levitus, by = "Year", all = T)
oceanheat <- merge(oceanheat, EN.4.2.2.c13, by = "Year", all = T)
oceanheat <- merge(oceanheat, EN.4.2.2.g10, by = "Year", all = T)
oceanheat <- merge(oceanheat, EN.4.2.2.l09, by = "Year", all = T)
oceanheat <- merge(oceanheat, IAP, by = "Year", all = T)
oceanheat <- merge(oceanheat, JMA, by = "Year", all = T)
oceanheat <- subset(oceanheat, select= -c(EN.4.2.2.c14.uncertainty,
Levitus.uncertainty,
EN.4.2.2.c13.uncertainty,
EN.4.2.2.g10.uncertainty,
EN.4.2.2.l09.uncertainty,
IAP.uncertainty,
JMA.uncertainty))
names(oceanheat)[names(oceanheat) == "EN.4.2.2.c14..10ZJ."] <- "EN.4.2.2.c14"
names(oceanheat)[names(oceanheat) == "Levitus..10ZJ."] <- "Levitus"
names(oceanheat)[names(oceanheat) == "EN.4.2.2.c13..10ZJ."] <- "EN.4.2.2.c13"
names(oceanheat)[names(oceanheat) == "EN.4.2.2.g10..10ZJ."] <- "EN.4.2.2.g10"
names(oceanheat)[names(oceanheat) == "EN.4.2.2.l09..10ZJ."] <- "EN.4.2.2.l09"
names(oceanheat)[names(oceanheat) == "IAP..10ZJ."] <- "IAP"
names(oceanheat)[names(oceanheat) == "JMA..10ZJ."] <- "JMA"
dygraph(oceanheat, main = "") %>%
dyOptions(colors = RColorBrewer::brewer.pal(7, "Dark2")) %>%
dyOptions(fillGraph = TRUE, fillAlpha = 0.1) %>%
dyAxis("y", label = "10<sup>22</sup> Joules") %>%
dyRangeSelector()
```
### Global sea level difference from 1981-2010
```{r}
palmer <- read.csv(url("https://climate.metoffice.cloud/formatted_data/sea_level_lt_Palmer%20et%20al.%202021.csv"))
palmer$Year <- as.numeric(palmer$Year)
CW2011 <- read.csv(url("https://climate.metoffice.cloud/formatted_data/sea_level_lt_CW2011.csv"))
CW2011$Year <- as.numeric(CW2011$Year)
HA2015 <- read.csv(url("https://climate.metoffice.cloud/formatted_data/sea_level_lt_HA2015.csv"))
HA2015$Year <- as.numeric(HA2015$Year)
DA2019 <- read.csv(url("https://climate.metoffice.cloud/formatted_data/sea_level_lt_DA2019.csv"))
DA2019$Year <- as.numeric(DA2019$Year)
FR2020 <- read.csv(url("https://climate.metoffice.cloud/formatted_data/sea_level_lt_FR2020.csv"))
FR2020$Year <- as.numeric(FR2020$Year)
sealevel <- merge(palmer, CW2011, by = "Year", all = T)
sealevel <- merge(sealevel, HA2015, by = "Year", all = T)
sealevel <- merge(sealevel, DA2019, by = "Year", all = T)
sealevel <- merge(sealevel, FR2020, by = "Year", all = T)
sealevel <- subset(sealevel, select= -c(Palmer.et.al..2021.uncertainty,
CW2011.uncertainty,
HA2015.uncertainty,
DA2019.uncertainty,
FR2020.uncertainty))
names(sealevel)[names(sealevel) == "Palmer.et.al..2021..mm."] <- "Palmer et al. 2021"
names(sealevel)[names(sealevel) == "CW2011..mm."] <- "CW2011"
names(sealevel)[names(sealevel) == "HA2015..mm."] <- "HA2015"
names(sealevel)[names(sealevel) == "DA2019..mm."] <- "DA2019"
names(sealevel)[names(sealevel) == "FR2020..mm."] <- "FR2020"
dygraph(sealevel, main = "") %>%
dyOptions(colors = RColorBrewer::brewer.pal(5, "Set2")) %>%
dyOptions(fillGraph = TRUE, fillAlpha = 0.1) %>%
dyAxis("y", label = "Milimetres (mm)") %>%
dyRangeSelector()
```
United Kingdom
=====================================
Column {data-width=500}
-------------------------------------
### UK annual mean air temperature
```{r}
setwd("C:/Users/bodna/OneDrive - University College London/Roadmap to Climate Resilience/Working folder/Data")
uk <- read.csv("uk_temp.csv")
dygraph(uk, main = "") %>%
dySeries("ann", label = "°C") %>%
dyOptions(fillGraph = TRUE, fillAlpha = 0.1) %>%
dyAxis("y", label = "Temperature (°C)") %>%
dyLegend(show = "always", hideOnMouseOut = T) %>%
dyRangeSelector()
```
### Great Britain sea level from tide gauges
```{r}
setwd("C:/Users/bodna/OneDrive - University College London/Roadmap to Climate Resilience/Working folder/Data/sea level")
sea <- read.csv("uk2.csv")
dygraph(sea, main = "") %>%
dySeries("mm", label = "mm", color = "lightblue") %>%
dyAxis("y", label = "Sea level (mm)") %>%
dyOptions(fillGraph = TRUE, fillAlpha = 0.8) %>%
dyLegend(show = "always", hideOnMouseOut = T) %>%
dyRangeSelector()
```
Row {data-height=500}
-------------------------------------
### London annual maximum and minimum air temperature
```{r}
setwd("C:/Users/bodna/OneDrive - University College London/Roadmap to Climate Resilience/Working folder/Data")
london <- read.csv("london.csv")
london_monthly_combined <- london %>%
group_by(year) %>%
summarise(across(c(tmax, tmin), mean, na.rm=TRUE))
dygraph(london_monthly_combined, main = "") %>%
dySeries("tmax", label = "Max temperature", color = "red") %>%
dySeries("tmin", label = "Min temperature", color = "blue") %>%
dyAxis("y", label = "Temperature (°C)") %>%
dyLegend(show = "always", hideOnMouseOut = T) %>%
dyRangeSelector()
```
### London annual mean precipitation
```{r}
setwd("C:/Users/bodna/OneDrive - University College London/Roadmap to Climate Resilience/Working folder/Data")
london <- read.csv("london.csv")
london_monthly_combined <- london %>%
group_by(year) %>%
summarise(across(c(rain_mm), mean, na.rm=TRUE))
dygraph(london_monthly_combined, main = "") %>%
dySeries("rain_mm", label = "mm", color = "darkblue") %>%
dyAxis("y", label = "Rain (mm)") %>%
dyOptions(fillGraph = TRUE, fillAlpha = 0.1) %>%
dyLegend(show = "always", hideOnMouseOut = T) %>%
dyRangeSelector()
```
### London annual mean wind speed
```{r}
setwd("C:/Users/bodna/OneDrive - University College London/Roadmap to Climate Resilience/Working folder/Data")
wind <- read.csv("wind.csv")
wind_combined <- wind %>%
group_by(Year) %>%
summarise(across(c(wspd), mean, na.rm=TRUE))
dygraph(wind_combined, main = "") %>%
dySeries("wspd", label = "km/h", color = "green") %>%
dyAxis("y", label = "Wind speed (km/h)") %>%
dyOptions(fillGraph = TRUE, fillAlpha = 0.1) %>%
dyLegend(show = "always", hideOnMouseOut = T) %>%
dyRangeSelector()
```
Climate projections - United Kingdom
=====================================
Column {data-width=250}
-------------------------------------
### Annual Average Temperature Change
```{r}
uk_temp <- sf::read_sf("https://services.arcgis.com/Lq3V5RFuTBC9I7kv/arcgis/rest/services/Annual_Average_Temperature_Change___Projections_12km_grid/FeatureServer/334/query?outFields=*&where=1%3D1&f=geojson")
pal <- colorNumeric("YlOrRd", NULL)
leaflet(uk_temp) %>%
addTiles() %>%
addPolygons(stroke = FALSE, smoothFactor = 0.3, fillOpacity = 0.8,
fillColor = ~pal(tas_annual_change_40_median), group = "4°C") %>%
addPolygons(stroke = FALSE, smoothFactor = 0.3, fillOpacity = 0.8,
fillColor = ~pal(tas_annual_change_30_median), group = "3°C") %>%
addPolygons(stroke = FALSE, smoothFactor = 0.3, fillOpacity = 0.8,
fillColor = ~pal(tas_annual_change_15_median), group = "1.5°C") %>%
addLayersControl(
overlayGroups = c("1.5°C", "3°C", "4°C"),
options = layersControlOptions(collapsed = F)) %>%
hideGroup(c("3°C", "4°C")) %>%
addLegend("bottomright",
colors = c("#ffffb2", "#fecc5c", "#fd8d3c", "#f03b20", "#bd0026"),
labels = c("2.6", "", "", "", "3.6"),
title = "4°C",
opacity = 0.7) %>%
addLegend("bottomright",
colors = c("#ffffb2", "#fecc5c", "#fd8d3c", "#f03b20", "#bd0026"),
labels = c("1.9", "", "", "", "2.7"),
title = "3°C",
opacity = 0.7) %>%
addLegend("bottomright",
colors = c("#ffffb2", "#fecc5c", "#fd8d3c", "#f03b20", "#bd0026"),
labels = c("0.8", "", "", "", "1.2"),
title = "1.5°C",
opacity = 0.7)
```
Column {data-width=250}
-------------------------------------
### Annual Average Precipitation (2050-2079)
```{r}
uk_perc <- sf::read_sf("https://services.arcgis.com/Lq3V5RFuTBC9I7kv/arcgis/rest/services/Rainfall_average_annual_2050_79_rcp85/FeatureServer/0/query?outFields=*&where=1%3D1&f=geojson")
pal <- colorNumeric("Spectral", NULL)
leaflet(uk_perc) %>%
addTiles() %>%
addPolygons(stroke = FALSE, smoothFactor = 0.3, fillOpacity = 0.8,
fillColor = ~pal(prMedian), group = "data") %>%
addLegend("bottomright",
colors = c("#d7191c", "#fdae61", "#ffffbf", "#abdda4", "#2b83ba"),
labels = c("1", "", "", "", "10"),
title = "mm/day",
opacity = 0.7)
```
Column {data-width=250}
-------------------------------------
### Drought Severity Index (12-Month Accumulations)
```{r}
uk_drought <- sf::read_sf("https://services.arcgis.com/Lq3V5RFuTBC9I7kv/arcgis/rest/services/Drought_Severity_Index_12_Month_Accumulations/FeatureServer/0/query?outFields=*&where=1%3D1&f=geojson")
pal <- colorNumeric("RdYlGn", NULL)
leaflet(uk_drought) %>%
addTiles() %>%
addPolygons(stroke = FALSE, smoothFactor = 0.3, fillOpacity = 0.9,
fillColor = ~pal(-DSI12_40_median), group = "4°C") %>%
addPolygons(stroke = FALSE, smoothFactor = 0.3, fillOpacity = 0.8,
fillColor = ~pal(-DSI12_30_median), group = "3°C") %>%
addPolygons(stroke = FALSE, smoothFactor = 0.3, fillOpacity = 0.7,
fillColor = ~pal(-DSI12_15_median), group = "1.5°C") %>%
addLayersControl(
overlayGroups = c("1.5°C", "3°C", "4°C"),
options = layersControlOptions(collapsed = F)) %>%
hideGroup(c("3°C", "4°C")) %>%
addLegend("bottomright",
colors = c("#1a9641", "#a6d96a", "#ffffbf", "#fdae61", "#d7191c"),
labels = c("6", "", "", "", "35"),
title = "4°C",
opacity = 0.7) %>%
addLegend("bottomright",
colors = c("#1a9641", "#a6d96a", "#ffffbf", "#fdae61", "#d7191c"),
labels = c("5", "", "", "", "20"),
title = "3°C",
opacity = 0.7) %>%
addLegend("bottomright",
colors = c("#1a9641", "#a6d96a", "#ffffbf", "#fdae61", "#d7191c"),
labels = c("4", "", "", "", "12"),
title = "1.5°C",
opacity = 0.7)
```
Column {data-width=300}
-------------------------------------
### Time-mean sea-level projection at Southend-on-Sea
```{r}
setwd("C:/Users/bodna/OneDrive - University College London/Roadmap to Climate Resilience/Working folder/Data/sea level")
sealevel_pro2 <- read.csv("southend.csv")
dygraph(sealevel_pro2, main = "") %>%
dySeries("SSP1.2.6", label = "RCP 2.6", color = "blue") %>%
dySeries("SSP2.4.5", label = "RCP 4.5", color = "orange") %>%
dySeries("SSP5.8.5", label = "RCP 8.5", color = "red") %>%
dyAxis("y", label = "Sea level (cm)") %>%
dyLegend(show = "always", hideOnMouseOut = T)
```